﻿unit TCPClient;

interface

uses
  System.SysUtils,
  System.Classes,
  WinSock2Ex,
  ContextFactory,
  MemBuffer,
  TCPEngine,
  EventHandler,
  WinSocket,
  Protocol;

type
  TOnCreateClient = function: TIClientContext of object;
  TOnChannelEvent = procedure(FChannel: TObject) of object;
  TOnChannelIORSEvent = procedure(FDIChannel: TObject; FDIBuffer: TIBuffer; dwIoSize: Cardinal) of object;

  (* TCP客户端 *)
  TBaseClient = class(TComponent)
  private
    FTCPEngine: TITCPEngine;              (* TCP客户端          *)
    FClientContext: TIClientContext;      (* 客户端上下文       *)
  private
    FHost: string;                   (* 服务器IP地址       *)
    FPort: Integer;                      (* 侦听端口           *)
    FBuffCount: Integer;                  (* 内存池数量         *)
    FClientCount: Integer;               (* 用户连接数         *)
    FThreadCount: Integer;               (* 工作线程数         *)
  published
    property Host: string read FHost write FHost;
    property Port: Integer read FPort write FPort;
    property BuffCount: Integer read FBuffCount write FBuffCount;
    property ClientCount: Integer read FClientCount write FClientCount;
    property ThreadCount: Integer read FThreadCount write FThreadCount;
  private
    OnChannelOpenEvent:  TOnChannelEvent;         (*  通道打开        *)
    OnChannelCloseEvent: TOnChannelEvent;         (*  通道关闭        *)
    OnChannelRecvEvent:  TOnChannelIORSEvent;     (*  通道接收数据    *)
    OnChannelSendEvent:  TOnChannelIORSEvent;     (*  通道发送数据    *)
    OnCreateClientEvent: TOnCreateClientEvent;    (*  创建上下文事件  *)
  published
    property FOpenSocket: TOnChannelEvent read OnChannelOpenEvent write OnChannelOpenEvent;
    property FCloseSocket: TOnChannelEvent read OnChannelCloseEvent write OnChannelCloseEvent;
    property FRecvSocket: TOnChannelIORSEvent read OnChannelRecvEvent write OnChannelRecvEvent;
    property FSendSocket: TOnChannelIORSEvent read OnChannelSendEvent write OnChannelSendEvent;
    property FNewClientObj: TOnCreateClientEvent read OnCreateClientEvent write OnCreateClientEvent;
  public
    procedure NewSocket(FChannel: TObject);
    procedure CloseSocket(FChannel: TObject);
    procedure RecvData(FChannel: TObject; FBuffer: TIBuffer; dwIoSize: Cardinal);
    procedure SendData(FChannel: TObject; FBuffer: TIBuffer; dwIoSize: Cardinal);
    function Start: Boolean;
		procedure Stop;
  public
    constructor Create(AOwner: TComponent);override;
    destructor Destroy; override;
    property TCPEngine: TITCPEngine read FTCPEngine;
    property ClientContext: TIClientContext read FClientContext;
  end;

  procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('TIOCP', [TBaseClient]);
end;

constructor TBaseClient.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FClientContext := nil;
  FBuffCount := 100;
  FClientCount := 1;
  FHost := 'localhost';
  FPort := 8988;
  FTCPEngine := TITCPEngine.Create;
  FTCPEngine.OnChannelOpenEvent := NewSocket;
  FTCPEngine.OnChannelCloseEvent := CloseSocket;
  FTCPEngine.OnChannelRecvEvent := RecvData;
  FTCPEngine.OnChannelSendEvent := SendData;
end;

destructor TBaseClient.Destroy;
begin
  FreeAndNil(FTCPEngine);
  inherited Destroy;
end;

procedure TBaseClient.NewSocket(FChannel: TObject);
var
  sIP: string;
begin
  sIP := (FChannel as TIClientContext).RemoteIP;
  if Assigned(FOpenSocket) then FOpenSocket(FChannel);
end;

procedure TBaseClient.CloseSocket(FChannel: TObject);
var
  sIP: string;
begin
  sIP := (FChannel as TIClientContext).RemoteIP;
  if Assigned(FCloseSocket) then FCloseSocket(FChannel);
end;

procedure TBaseClient.RecvData(FChannel: TObject; FBuffer: TIBuffer; dwIoSize: Cardinal);
begin
  if Assigned(FRecvSocket) then FRecvSocket(FChannel, FBuffer, dwIoSize);
end;

procedure TBaseClient.SendData(FChannel: TObject; FBuffer: TIBuffer; dwIoSize: Cardinal);
begin
  if Assigned(FSendSocket) then FSendSocket(FChannel, FBuffer, dwIoSize);
end;

function TBaseClient.Start: Boolean;
var
  sStr: AnsiString;
begin
  Result := False;
  if not Assigned(FNewClientObj) then
    begin
      raise Exception.Create('创建客户端实例!');
      Exit;
    end
  else
    FClientContext := FNewClientObj;
  FTCPEngine.MaxMemPool := FBuffCount;
  FTCPEngine.WorkThreadPool.ActiveThreads := FClientCount;
  Result := FTCPEngine.StartEngine;
  FTCPEngine.EngineWorked := True;
  Result := FClientContext.Connect(FHost, FPort);
//  if Result then
//  begin
//    sStr := 'E.Message';
//    FClientContext.SendStream(@sStr[1], Length(sStr));
//  end;
end;

procedure TBaseClient.Stop;
begin
  FClientContext.CloseSocket;
  FTCPEngine.StopEngine;
end;

end.
